home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1990 January
/
64er_Magazin_90-01_1990_Markt__Technik_de_Side_A.d64
/
sub dir sys 1.2
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
12KB
|
556 lines
100 rem ******************
110 rem * *
120 rem * sub dir system *
130 rem * 64'er 2/89 s36 *
140 rem ******************
150 rem
160 rem (c) 1988 by
170 rem dirk jansen
180 rem
190 rem ver 1.1 - 21.07.88
200 rem ==================
210 :
220 print chr$(147)
230 print tab(13);"sub dir system"
240 print
250 print tab(13);"v1.1 21.07.88"
260 print
270 print tab(8);"(c) 1988 by dirk jansen"
280 print
282 print tab(5);"enlarged 1989 by horst stieler"
284 print
290 print"========================================"
300 gosub 4000:rem * geraete nummern abfragen
310 nu$=chr$(0): restore: for i=0 to 7: read by$: next i
312 d0$=str$(0)+str$(5)+str$(35)
314 d1$=""
316 for i=1 to 17: read by: d1$=d1$+str$(by): next i
318 read by
320 d2$=""
322 for i=19 to 22: read by: d2$=d2$+str$(by): next i
324 read by
326 d3$=""
328 for i=24 to 35: read by: d3$=d3$+str$(by): next i
329 restore
330 gosub 44650
332 dim fe$(29),ft$(4),fs$(3)
334 ft$(0)="del": ft$(1)="seq": ft$(2)="prg": ft$(3)="usr": ft$(4)="rel"
335 dim ba(35,4)
340 print chr$(147)
350 print"***** sub dir system v 1.1 *****"
360 print
370 print "geraet:";u,"laufwerk: ";d$
380 print:print
390 print" 1 - sub dir system anlegen"
400 print
410 print" 2 - sub dir anlegen"
420 print
430 print" 3 - disk befehl"
440 print
450 print" 4 - inhaltsverzeichnis"
460 print
470 print" 5 - geraete nummern aendern"
480 print
481 print" 6 - directorys listen/drucken"
482 print
483 print" 7 - diskette validieren"
484 print
485 print" 8 - sub dir loeschen"
486 print
490 print" 0 - programm ende"
500 print:print
510 input"ihre wahl";o
520 on o+1 gosub 1000,10000,20000,2000,3000,4000,41050,41420,42000
530 goto 340
970 :
980 rem *** ende ***
990 :
1000 sys 64738
1970 :
1980 rem *** disk befehl ***
1990 :
2000 print
2010 poke 198,3
2020 poke 631,34
2030 poke 632,20
2040 poke 633,34
2050 a$=""
2060 input"befehl";a$
2070 open 15,u,15
2080 if a$="" then 2200
2090 print#15,a$
2200 print
2210 print"status: ";
2220 get#15,e$: if e$<>chr$(13) then printe$;: goto 2220
2230 close15
2240 print:print:print"- taste druecken -"
2250 get a$: if a$="" then 2250
2260 return
2970 :
2980 rem *** inhaltsverzeichnis ***
2990 :
3000 print
3010 open 1,u,0,"$"+d$
3020 poke 781,1
3040 get#1,a$,a$
3050 get#1,a$,a$: if st=64 then 3110
3060 : get#1,a$,b$:printchr$(157);asc(a$+chr$(0))+256*asc(b$+chr$(0));
3070 : get#1,a$:print a$;: if a$<>"" then 3070
3080 : print
3090 goto 3050
3110 close 1
3120 print:print:print"- taste druecken -"
3130 get a$: if a$="" then 3130
3140 return
3970 :
3980 rem *** geraete nummern aendern ***
3990 :
4000 print
4010 input"geraete nummer? 8[157][157][157]";u
4020 if u<8 or u>15 then 4010
4030 input"laufwerk ? 0[157][157][157]";d$
4040 if d$<>"0" and d$<>"1" then 4030
4050 return
9970 :
9980 rem *** system anlegen ***
9990 :
10000 open 15,u,15,"i"+d$
10010 input#15,e1,e2$,e3,e4
10020 if e1=0 then 10100
10030 print
10040 print"*** disk: ";e1;e2$;e3;e4;"***"
10050 print
10060 return
10100 open 2,u,2,"#"
10110 print#15,"u1 2 ";d$;" 18 1"
10112 for i=2 to 226 step 32
10120 : print#15,"b-p 2";i
10130 : get#2,t$
10150 : if t$<>"" then 10170
10160 next i
10162 print#15,"b-p 2 0"
10164 get#2,t$
10166 if t$="" then 10220
10170 : print
10180 : print"*** disk ist nicht leer ***"
10190 : print
10200 : input"disk loeschen(j/n)? n[157][157][157]";a$
10210 : if a$="n" then close2:close15: return
10220 : print:print"impressum schreiben"
10222 print#15,"b-p 2 00"
10230 print#2,chr$(0);chr$(255);
10240 for i=0 to 7
10242 : print#15,"b-p 2";i*32+2
10250 : print#2,chr$(195);chr$(18);chr$(0);
10260 : read a$
10270 : print#2,left$(a$+"[160][160][160][160][160][160][160][160][160][160][160][160][160][160][160]",16);
10280 : print#2,chr$(0);chr$(0);chr$(0);
10290 : print#2,"dirk";
10300 : print#2,chr$(0);chr$(0);
10310 : print#2,chr$(0);chr$(0);
10320 next i
10330 print#15,"u2 2 ";d$;" 18 01"
10340 print:print"root dir anlegen"
10350 close2
10360 close15
10370 n$="======root======":rem -nameuebergeben
10380 gosub 30000:rem - dir anlegen
10470 open15,u,15
10480 print:print"init disk"
10490 print#15,"i";d$
10500 print:print"validate disk"
10510 print#15,"v";d$
10520 close15
10530 return
10662 print#15,"b-p 2 0"
10664 get#2,t$
10666 if t$<>"" then 10180
12000 data " sub dir system "
12010 data "(w) '88 d.jansen"
12020 data " "
12030 data "use disk command"
12040 data " &xxxxxx to "
12050 data " change dir "
12060 data " "
12070 data " don't validate "
19970 :
19980 rem *** dir anlegen ***
19990 :
20000 print
20010 n$="":input"dir name (max 15 zeichen)";n$
20020 if len(n$)>15 or len(n$)<1 then 20010
20030 n1$=n$
20040 if len(n$)<16 then n$="="+n$+"=":goto 20040
20050 n$=left$(n$,16)
21000 print:print"dir anlegen"
21010 gosub 30000:rem - dir anlegen
21900 restore
21910 for i=0 to 7
21920 : read a$
21930 next i
22000 print:print"umschalt befehl anlegen t:";t;" s:";s
22010 open2,u,2,"&"+n1$+",u,w"
22020 print#2,chr$(0);chr$(5);:rem - startadresse
22030 print#2,chr$(35);:rem - anzahl bytes
22040 p=0
22050 for i=1 to 35
22060 : read a
22070 : if a=-1 then a=t
22080 : if a=-2 then a=s
22090 : p=p+a: if p>255 then p=p-255
22100 : print#2,chr$(a);
22110 next i
22120 p=p+5+35
22130 p=p-(255*int(p/256))
22140 print#2,chr$(p);
22150 close2
23000 print:print"umschalten"
23010 open15,u,15
23020 open 2,u,2,"#"
23030 print#15,"u1 2 ";d$;" 18 01"
23040 print#15,"b-p 2 0"
23050 get#2,t$,s$
23060 t=asc(t$+chr$(0))
23070 s=asc(s$+chr$(0))
23080 close2
23090 print#15,"&"+n1$
23100 close15
23900 restore
23910 for i=0 to 7
23920 : read a$
23930 next i
24000 print:print"rueckschalt befehl anlegen t:";t;" s:";s
24010 open2,u,2,"&back,u,w"
24020 print#2,chr$(0);chr$(5);:rem - startadresse
24030 print#2,chr$(35);:rem - anzahl bytes
24040 p=0
24050 for i=1 to 35
24060 : read a
24070 : if a=-1 then a=t
24080 : if a=-2 then a=s
24090 : p=p+a: if p>255 then p=p-255
24100 : print#2,chr$(a);
24110 next i
24120 p=p+5+35
24130 p=p-(255*int(p/256))
24140 print#2,chr$(p);
24150 close2
25000 print:print"rueckschalten"
25010 open15,u,15
25020 print#15,"&back"
25030 close15
25040 return
29970 :
29980 rem *** dir anlegen ***
29990 :
30000 open15,u,15
30010 open 2,u,2,"#"
30020 print#15,"u1 2 ";d$;" 18 01"
30030 print#15,"b-p 2 0"
30040 get#2,t$
30050 t1=asc(t$+chr$(0))
30070 print#15,"b-a ";d$;" 18 00"
30080 input#15,a,a$,t,s
30090 print#15,"b-a ";d$;t;s
30100 print#15,"b-p 2 00"
30110 print#2,chr$(0);chr$(255);
30120 print#2,chr$(195);chr$(18);chr$(0);
30130 print#2,left$(n$+"[160][160][160][160][160][160][160][160][160][160][160][160][160][160][160][160]",16);
30140 print#2,chr$(0);chr$(0);chr$(0);
30150 print#2,"dir ";
30160 print#2,chr$(0);chr$(0);
30170 print#2,chr$(0);chr$(0);
30180 print#2,chr$(0);chr$(0);
30260 for i=34 to 253
30270 : print#2,chr$(0);
30280 next i
30300 print#15,"u2 2 ";d$;t;s
30310 if t1=18 then 30500
30320 : print#15,"u1 2 ";d$;" 18 01"
30330 : print#15,"b-p 2 0"
30340 : print#2,chr$(t);chr$(s);
30350 : print#15,"u2 2 ";d$;" 18 01"
30500 close15
30510 close2
30520 return
39970 :
39980 rem *** daten fuer & file ***
39990 :
40000 data 169,18,133,8,169,1,133,9,169,128,133,1,165,1,48,252,169,-1,141,0,4
40010 data 169,-2,141,1,4,169,144,133,1,165,1,48,252,96
41000 :
41010 rem *****************************
41020 rem * directorys listen/drucken
41030 rem *
41050 dr=b0
41060 print"ausgabe auch auf drucker ? (j/n)"
41070 get by$: if by$="" then 41070
41080 if by$<>"j" then 41140
41090 print"geraeteadresse (4/5) ?": by$=""
41100 get by$:if by$="" then 41100
41110 pr=val(by$): if pr>=4 and pr<=5 then dr=b1: open4,pr: goto 41140
41120 print"geraeteadresse ist nicht 4 oder 5": goto 41320
41140 he=1
41150 open15,u,15
41160 open2,u,2,"#"
41190 print#15,"u1 2 ";d$;" 18 0"
41200 print#15,"b-p 2 144"
41210 dn$="": for i=144 to 159: get#2,by$: dn$=dn$+by$: next i: get#2,by$,by$
41220 id$="": for i=162 to 166: get#2,by$: id$=id$+by$: next i
41230 ue$=" 0 "+chr$(34)+dn$+chr$(34)+" "+id$+"[146]"
41250 de=0
41260 gosub 42610
41280 print#15,"m-r"chr$(250)chr$(2)chr$(3)
41290 get#15,lo$,by$,hi$
41300 print 256*asc(hi$+nu$)+asc(lo$+nu$);" blocks free."
41310 if dr=b1 then print#4,256*asc(hi$+nu$)+asc(lo$+nu$);" blocks free."
41320 close 2
41330 close 15
41340 if dr=b1 then dr=b0: print#4: close 4
41350 gosub 2240
41360 return
41380 rem *****************************
41390 rem * diskette validieren
41400 rem *
41420 he=2
41430 open15,u,15
41440 open2,u,2,"#"
41480 print#15,"r:&back=&back"
41490 input#15,e1,by$,by,by
41500 if e1=62 then 41560
41510 print"working-directory ist nicht die root-"
41520 print"directory"
41530 close 2: gosub 2240: goto 41930
41560 for i=1 to 35
41570 for j=2 to 4
41580 ba(i,j)=255
41590 next j
41600 next i
41620 gosub 44480
41640 de=0
41650 gosub 42610
41680 print"berechnung der freien bloecke pro spur"
41690 for i=1 to 35
41700 ei=0
41710 for j=2 to 4
41720 dz=ba(i,j)
41730 dz=dz/2: if dz<>int(dz) then ei=ei+1
41740 dz=int(dz): if dz>0 then 41730
41750 next j
41760 ba(i,1)=ei: print".";
41770 next i
41790 close 2
41810 print: print"schreiben der bam"
41820 for i=1 to 35
41830 print#15,"m-w"chr$(4*i)chr$(7)chr$(2)chr$(ba(i,1))chr$(ba(i,2))
41840 print#15,"m-w"chr$(4*i+2)chr$(7)chr$(2)chr$(ba(i,3))chr$(ba(i,4))
41850 next i
41880 print#15,"m-w"chr$(14)chr$(0)chr$(2)chr$(18)chr$(0)
41890 print#15,"m-w"chr$(4)chr$(0)chr$(1)chr$(144)
41900 print#15,"m-r"chr$(4)chr$(0): get#15,by$: if by$=chr$(144) then 41900
41920 print#15,"i";d$
41930 close 15
41940 return
41960 rem *****************************
41970 rem * delete dir
41980 rem *
42000 open15,u,15
42010 open2,u,2,"#"
42020 get#2,by$: pn=asc(by$+nu$)
42040 input"zu loeschendes directory";di$
42050 di$="&"+di$
42060 if len(di$)>16 then print"name zu lang": gosub2240: goto 42480
42090 print"directory wechseln"
42100 print#15,di$
42110 input#15,e1,e2$,e3,e4
42120 if e1<>0 then print e1,e2$,e3,e4: gosub 2240: goto 42480
42210 an=1: de=1: ze=0: az=0: rk=0: ak=3
42220 gosub 43350
42230 if rk=0 then 42290
42240 print"subdirectory ist nicht leer"
42250 print#15,"&back"
42260 gosub 2240: goto 42480
42290 print"directoryueberschrift loeschen"
42300 print#15,"u1 2 ";d$;str$(t1);str$(s1)
42310 print#15,"m-w"chr$(2)chr$(pn+3)chr$(1)chr$(0)
42320 print#15,"u2 2 ";d$;str$(t1);str$(s1)
42350 print#15,"u1 2 ";d$;str$(t2);str$(s2)
42380 print"'&back'-datei loeschen"
42390 print#15,"s";d$;":&back,u"
42420 print"rueckschalten"
42430 print#15,"m-e"chr$(5)chr$(pn+3)
42450 print"subdirectoryeintrag loeschen"
42460 print#15,"s";d$;":";di$
42480 close 2
42490 close 15
42500 return
42520 rem *******************************************
42530 rem * directorys drucken / diskette validieren
42540 rem *
42610 if he=2 then ak=2: goto 42860
42620 ak=1: an=1
42660 print spc(de);ue$
42670 if dr=b1 then print#4,spc(de);ue$
42680 gosub 44770: if p3=b1 then 42790
42690 print spc(de);" weg: ";
42700 if dr=b1 then print#4,spc(de);" weg: ";
42710 for i=k3 to sp+1 step -1
42720 print mid$(sk$(i),6);
42730 if dr=b1 then print#4,mid$(sk$(i),6);
42740 if i>sp+1 then print"/";: if dr=b1 then print#4,"/";
42750 next i
42760 print: if dr=b1 then print#4
42790 tr=18: sc=1
42800 ze=0
42810 gosub 43350
42820 print: if dr=b1 then print#4
42860 tr=18: sc=1: ze=0
42870 sa=ak: if he=1 then ak=2
42880 gosub 43350
42890 ak=sa
42900 if rc=0 then 43100
42940 va$=chr$(tr)+chr$(sc)+chr$(ze)+chr$(nt)+chr$(ns)
42950 for i=1 to 16: z$=mid$(f$,i,1): ifz$<>"[160]"thenva$=va$+z$:rem shift-space!
42960 next i
42970 gosub 44850
42990 print#15,f$
43000 de=de+1
43010 an=1
43020 if he=1 then 42660
43050 gosub 44480
43060 an=1
43070 goto 42860
43100 gosub 44770
43110 if p3=b1 then f$="": return
43140 gosub 44940
43150 tr=asc(mid$(va$,1,1))
43160 sc=asc(mid$(va$,2,1))
43170 ze=asc(mid$(va$,3,1))
43180 nt=asc(mid$(va$,4,1))
43190 ns=asc(mid$(va$,5,1))
43230 print#15,"&back": de=de-1: an=0
43250 ze=ze+1
43260 goto 42870
43280 rem *****************************
43290 rem * alle directoryeintraege einer dir. abklappern
43300 rem *
43350 if an=0 then 43430
43360 if de=0 then 43430
43390 print#15,"u1 2 ";d$;" 18 1"
43400 get#2,tr$,sc$: tr=asc(tr$+nu$): sc=asc(sc$+nu$)
43430 print#15,"u1 2 ";d$;tr;sc
43450 get#2,nt$,ns$: nt=asc(nt$+nu$): ns=asc(ns$+nu$)
43480 print#15,"b-p 2 ";ze*32+2
43490 for i=0 to 29: get#2,fe$(i): next i
43520 on ak goto 43550,43730,43800
43550 if asc(fe$(0)+nu$)=0 then 43700
43560 bl=256*asc(fe$(29)+nu$)+asc(fe$(28)+nu$)
43570 f$=str$(bl)
43580 if bl<100 then f$=f$+" "
43590 if bl<10 then f$=f$+" "
43600 f$=f$+" "+chr$(34)
43610 for j=3 to 18: f$=f$+fe$(j): next j
43620 f$=f$+chr$(34)+" "
43630 ft=asc(fe$(0)+nu$)
43640 if (ft and 2^7)=0 then f$=f$+"*": goto 43660
43650 f$=f$+" "
43660 f$=f$+ft$(ft and 3)
43670 if ft and 2^6 then f$=f$+"<"
43680 print spc(de);f$
43690 if dr=b1 then print#4,spc(de);f$
43700 goto 43980
43730 gosub 44080
43740 if rc=1 then return
43770 goto43980
43800 ft=asc(fe$(0)+nu$)
43810 if az>0 then 43880
43820 bl=256*asc(fe$(29)+nu$)+asc(fe$(28)+nu$)
43830 if ft<>195 or bl<>0 then rk=1: return
43850 t1=tr: s1=sc
43860 az=1
43870 goto 43980
43880 if ft=0 then 43980
43890 if ft<>131 then rk=1: return
43900 if az=2 then rk=1: return
43920 f$="": for j=3 to 18: f$=f$+fe$(j): next j
43930 iff$<>"&back[160][160][160][160][160][160][160][160][160][160][160]"thenrk=1:return
43940 t2=asc(fe$(1)+nu$)
43950 s2=asc(fe$(2)+nu$)
43960 az=2
43980 ze=ze+1
43990 if ze=8 and nt=0 then rc=0: return
44000 if ze=8 then tr=nt: sc=ns: ze=0: goto 43430
44010 goto 43480
44030 rem *****************************
44040 rem * test, ob eintrag directoryeintrag
44050 rem *
44080 rc=0
44090 if (asc(fe$(0)+nu$) and 131)<>131 then return
44100 if 256*asc(fe$(29)+nu$)+asc(fe$(28)+nu$)<>1 then return
44110 if fe$(3)<>"&" then return
44130 f$="": for i=3 to 18: f$=f$+fe$(i): next i
44140 if f$="&back[160][160][160][160][160][160][160][160][160][160][160]" then return: rem !! dies sind <shift><space>
44180 open3,u,3,f$+",u,r"
44190 fs$(0)=""
44200 for i=0 to 2: get#3,by$: fs$(0)=fs$(0)+str$(asc(by$+nu$)): next i
44210 p=0
44220 fs$(1)="": fs$(2)="": fs$(3)=""
44230 for i=1 to 35
44240 get#3,by$
44250 if (i=18) or (i=23) then 44280
44260 z=-(i>0 and i<18)-2*(i>18 and i<23)-3*(i>23 and i<36)
44270 fs$(z)=fs$(z)+str$(asc(by$+nu$))
44280 p=p+asc(by$+nu$)
44290 if p>255 then p=p-255
44300 next i
44310 get#3,by$
44320 close 3
44330 p=p+5+35
44340 p=p-(255*int(p/256))
44350 if p<>asc(by$+nu$) then return
44380 if d0$<>fs$(0) or d1$<>fs$(1) or d2$<>fs$(2) or d3$<>fs$(3) then return
44410 rc=1
44420 return
44440 rem *****************************
44450 rem * dir validieren & in der computerbam bloecke belegen
44480 print"validiere directory ";f$
44490 close 2
44500 print#15,"v";d$
44520 print#15,"m-r"chr$(4)chr$(7)chr$(140)
44530 for i=1 to 35
44540 get#15,by$,b2$,b3$,b4$
44550 ba(i,2)=ba(i,2) and asc(b2$+nu$)
44560 ba(i,3)=ba(i,3) and asc(b3$+nu$)
44570 ba(i,4)=ba(i,4) and asc(b4$+nu$)
44580 next i
44590 open2,8,2,"#"
44600 return
44620 rem *****************************
44630 rem * init-stack
44640 rem *
44650 k3=20
44660 dim sk$(k3)
44670 sp=k3
44680 b0=0
44690 b1=-1
44700 return
44720 rem *****************************
44730 rem * empty-stack
44760 rem *
44770 p3=b0
44780 if sp=k3 then p3=b1
44790 return
44810 rem *****************************
44820 rem * push
44840 rem *
44850 if sp<0 then print"stack overflow": close 2: close 15: end
44860 sk$(sp)=va$
44870 sp=sp-1
44880 return
44900 rem *****************************
44910 rem * pop
44930 rem *
44940 sp=sp+1
44950 va$=sk$(sp)
44960 return